| import qualified Maybe import qualified Prelude
|
| data FiniteMap a b = EmptyFM | Branch a b Int (FiniteMap a b) (FiniteMap a b)
|
| instance (Eq a, Eq b) => Eq (FiniteMap b a) where
|
| addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b
addToFM | fm key elt | = | addToFM_C (\old new ->new) fm key elt |
|
| addToFM_C :: Ord a => (b -> b -> b) -> FiniteMap a b -> a -> b -> FiniteMap a b
addToFM_C | combiner EmptyFM key elt | = | unitFM key elt |
addToFM_C | combiner (Branch key elt size fm_l fm_r) new_key new_elt | |
| | new_key < key | = |
mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r |
|
| | new_key > key | = |
mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) |
|
| | otherwise | = |
Branch new_key (combiner elt new_elt) size fm_l fm_r |
|
|
|
| deleteMax :: Ord b => FiniteMap b a -> FiniteMap b a
deleteMax | (Branch key elt _ fm_l EmptyFM) | = | fm_l |
deleteMax | (Branch key elt _ fm_l fm_r) | = | mkBalBranch key elt fm_l (deleteMax fm_r) |
|
| deleteMin :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMin | (Branch key elt _ EmptyFM fm_r) | = | fm_r |
deleteMin | (Branch key elt _ fm_l fm_r) | = | mkBalBranch key elt (deleteMin fm_l) fm_r |
|
| emptyFM :: FiniteMap b a
|
| filterFM :: Ord b => (b -> a -> Bool) -> FiniteMap b a -> FiniteMap b a
filterFM | p EmptyFM | = | emptyFM |
filterFM | p (Branch key elt _ fm_l fm_r) | |
| | p key elt | = |
mkVBalBranch key elt (filterFM p fm_l) (filterFM p fm_r) |
|
| | otherwise | = |
glueVBal (filterFM p fm_l) (filterFM p fm_r) |
|
|
|
| findMax :: FiniteMap b a -> (b,a)
findMax | (Branch key elt _ _ EmptyFM) | = | (key,elt) |
findMax | (Branch key elt _ _ fm_r) | = | findMax fm_r |
|
| findMin :: FiniteMap b a -> (b,a)
findMin | (Branch key elt _ EmptyFM _) | = | (key,elt) |
findMin | (Branch key elt _ fm_l _) | = | findMin fm_l |
|
| glueBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a
glueBal | EmptyFM fm2 | = | fm2 |
glueBal | fm1 EmptyFM | = | fm1 |
glueBal | fm1 fm2 | |
| | sizeFM fm2 > sizeFM fm1 | = |
mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) |
|
| | otherwise | = |
mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 | where |
mid_elt1 | | = | (\(_,mid_elt1) ->mid_elt1) vv2 |
|
mid_elt2 | | = | (\(_,mid_elt2) ->mid_elt2) vv3 |
|
mid_key1 | | = | (\(mid_key1,_) ->mid_key1) vv2 |
|
mid_key2 | | = | (\(mid_key2,_) ->mid_key2) vv3 |
|
|
|
|
|
|
|
| glueVBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
glueVBal | EmptyFM fm2 | = | fm2 |
glueVBal | fm1 EmptyFM | = | fm1 |
glueVBal | fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch key_r elt_r (glueVBal fm_l fm_rl) fm_rr |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch key_l elt_l fm_ll (glueVBal fm_lr fm_r) |
|
| | otherwise | = |
|
|
|
| mkBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkBalBranch | key elt fm_L fm_R | |
| | size_l + size_r < 2 | = |
mkBranch 1 key elt fm_L fm_R |
|
| | size_r > sIZE_RATIO * size_l | = |
case | fm_R of |
| Branch _ _ _ fm_rl fm_rr | |
| | sizeFM fm_rl < 2 * sizeFM fm_rr | -> |
|
| | otherwise | -> |
|
|
|
|
| | size_l > sIZE_RATIO * size_r | = |
case | fm_L of |
| Branch _ _ _ fm_ll fm_lr | |
| | sizeFM fm_lr < 2 * sizeFM fm_ll | -> |
|
| | otherwise | -> |
|
|
|
|
| | otherwise | = |
mkBranch 2 key elt fm_L fm_R | where |
double_L | fm_l (Branch key_r elt_r _ (Branch key_rl elt_rl _ fm_rll fm_rlr) fm_rr) | = | mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr) |
|
double_R | (Branch key_l elt_l _ fm_ll (Branch key_lr elt_lr _ fm_lrl fm_lrr)) fm_r | = | mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r) |
|
single_L | fm_l (Branch key_r elt_r _ fm_rl fm_rr) | = | mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr |
|
single_R | (Branch key_l elt_l _ fm_ll fm_lr) fm_r | = | mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r) |
|
|
|
|
|
|
|
| mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBranch | which key elt fm_l fm_r | = |
let |
result | | = | Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r |
|
|
in | result |
| where |
|
left_ok | | = |
case | fm_l of |
| EmptyFM | -> | True |
| Branch left_key _ _ _ _ | -> |
let |
biggest_left_key | | = | fst (findMax fm_l) |
|
|
in | biggest_left_key < key |
|
|
|
|
right_ok | | = |
case | fm_r of |
| EmptyFM | -> | True |
| Branch right_key _ _ _ _ | -> |
let |
smallest_right_key | | = | fst (findMin fm_r) |
|
|
in | key < smallest_right_key |
|
|
|
|
unbox :: Int -> Int
|
|
|
|
| mkVBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkVBalBranch | key elt EmptyFM fm_r | = | addToFM fm_r key elt |
mkVBalBranch | key elt fm_l EmptyFM | = | addToFM fm_l key elt |
mkVBalBranch | key elt fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch key_r elt_r (mkVBalBranch key elt fm_l fm_rl) fm_rr |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch key_l elt_l fm_ll (mkVBalBranch key elt fm_lr fm_r) |
|
| | otherwise | = |
mkBranch 13 key elt fm_l fm_r | where |
|
|
|
|
| sIZE_RATIO :: Int
|
| sizeFM :: FiniteMap a b -> Int
sizeFM | EmptyFM | = | 0 |
sizeFM | (Branch _ _ size _ _) | = | size |
|
| unitFM :: b -> a -> FiniteMap b a
unitFM | key elt | = | Branch key elt 1 emptyFM emptyFM |
|
| import qualified Maybe import qualified Prelude
|
| data FiniteMap a b = EmptyFM | Branch a b Int (FiniteMap a b) (FiniteMap a b)
|
| instance (Eq a, Eq b) => Eq (FiniteMap b a) where
|
| addToFM :: Ord b => FiniteMap b a -> b -> a -> FiniteMap b a
addToFM | fm key elt | = | addToFM_C addToFM0 fm key elt |
|
|
|
| addToFM_C :: Ord a => (b -> b -> b) -> FiniteMap a b -> a -> b -> FiniteMap a b
addToFM_C | combiner EmptyFM key elt | = | unitFM key elt |
addToFM_C | combiner (Branch key elt size fm_l fm_r) new_key new_elt | |
| | new_key < key | = |
mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r |
|
| | new_key > key | = |
mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) |
|
| | otherwise | = |
Branch new_key (combiner elt new_elt) size fm_l fm_r |
|
|
|
| deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMax | (Branch key elt _ fm_l EmptyFM) | = | fm_l |
deleteMax | (Branch key elt _ fm_l fm_r) | = | mkBalBranch key elt fm_l (deleteMax fm_r) |
|
| deleteMin :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMin | (Branch key elt _ EmptyFM fm_r) | = | fm_r |
deleteMin | (Branch key elt _ fm_l fm_r) | = | mkBalBranch key elt (deleteMin fm_l) fm_r |
|
| emptyFM :: FiniteMap b a
|
| filterFM :: Ord b => (b -> a -> Bool) -> FiniteMap b a -> FiniteMap b a
filterFM | p EmptyFM | = | emptyFM |
filterFM | p (Branch key elt _ fm_l fm_r) | |
| | p key elt | = |
mkVBalBranch key elt (filterFM p fm_l) (filterFM p fm_r) |
|
| | otherwise | = |
glueVBal (filterFM p fm_l) (filterFM p fm_r) |
|
|
|
| findMax :: FiniteMap a b -> (a,b)
findMax | (Branch key elt _ _ EmptyFM) | = | (key,elt) |
findMax | (Branch key elt _ _ fm_r) | = | findMax fm_r |
|
| findMin :: FiniteMap b a -> (b,a)
findMin | (Branch key elt _ EmptyFM _) | = | (key,elt) |
findMin | (Branch key elt _ fm_l _) | = | findMin fm_l |
|
| glueBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a
glueBal | EmptyFM fm2 | = | fm2 |
glueBal | fm1 EmptyFM | = | fm1 |
glueBal | fm1 fm2 | |
| | sizeFM fm2 > sizeFM fm1 | = |
mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) |
|
| | otherwise | = |
mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 | where |
|
mid_elt10 | (_,mid_elt1) | = | mid_elt1 |
|
|
mid_elt20 | (_,mid_elt2) | = | mid_elt2 |
|
|
mid_key10 | (mid_key1,_) | = | mid_key1 |
|
|
mid_key20 | (mid_key2,_) | = | mid_key2 |
|
|
|
|
|
|
|
| glueVBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
glueVBal | EmptyFM fm2 | = | fm2 |
glueVBal | fm1 EmptyFM | = | fm1 |
glueVBal | fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch key_r elt_r (glueVBal fm_l fm_rl) fm_rr |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch key_l elt_l fm_ll (glueVBal fm_lr fm_r) |
|
| | otherwise | = |
|
|
|
| mkBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBalBranch | key elt fm_L fm_R | |
| | size_l + size_r < 2 | = |
mkBranch 1 key elt fm_L fm_R |
|
| | size_r > sIZE_RATIO * size_l | = |
case | fm_R of |
| Branch _ _ _ fm_rl fm_rr | |
| | sizeFM fm_rl < 2 * sizeFM fm_rr | -> |
|
| | otherwise | -> |
|
|
|
|
| | size_l > sIZE_RATIO * size_r | = |
case | fm_L of |
| Branch _ _ _ fm_ll fm_lr | |
| | sizeFM fm_lr < 2 * sizeFM fm_ll | -> |
|
| | otherwise | -> |
|
|
|
|
| | otherwise | = |
mkBranch 2 key elt fm_L fm_R | where |
double_L | fm_l (Branch key_r elt_r _ (Branch key_rl elt_rl _ fm_rll fm_rlr) fm_rr) | = | mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr) |
|
double_R | (Branch key_l elt_l _ fm_ll (Branch key_lr elt_lr _ fm_lrl fm_lrr)) fm_r | = | mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r) |
|
single_L | fm_l (Branch key_r elt_r _ fm_rl fm_rr) | = | mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr |
|
single_R | (Branch key_l elt_l _ fm_ll fm_lr) fm_r | = | mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r) |
|
|
|
|
|
|
|
| mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBranch | which key elt fm_l fm_r | = |
let |
result | | = | Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r |
|
|
in | result |
| where |
|
left_ok | | = |
case | fm_l of |
| EmptyFM | -> | True |
| Branch left_key _ _ _ _ | -> |
let |
biggest_left_key | | = | fst (findMax fm_l) |
|
|
in | biggest_left_key < key |
|
|
|
|
right_ok | | = |
case | fm_r of |
| EmptyFM | -> | True |
| Branch right_key _ _ _ _ | -> |
let |
smallest_right_key | | = | fst (findMin fm_r) |
|
|
in | key < smallest_right_key |
|
|
|
|
unbox :: Int -> Int
|
|
|
|
| mkVBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkVBalBranch | key elt EmptyFM fm_r | = | addToFM fm_r key elt |
mkVBalBranch | key elt fm_l EmptyFM | = | addToFM fm_l key elt |
mkVBalBranch | key elt fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch key_r elt_r (mkVBalBranch key elt fm_l fm_rl) fm_rr |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch key_l elt_l fm_ll (mkVBalBranch key elt fm_lr fm_r) |
|
| | otherwise | = |
mkBranch 13 key elt fm_l fm_r | where |
|
|
|
|
| sIZE_RATIO :: Int
|
| sizeFM :: FiniteMap b a -> Int
sizeFM | EmptyFM | = | 0 |
sizeFM | (Branch _ _ size _ _) | = | size |
|
| unitFM :: a -> b -> FiniteMap a b
unitFM | key elt | = | Branch key elt 1 emptyFM emptyFM |
|
| import qualified Maybe import qualified Prelude
|
| data FiniteMap a b = EmptyFM | Branch a b Int (FiniteMap a b) (FiniteMap a b)
|
| instance (Eq a, Eq b) => Eq (FiniteMap a b) where
|
| addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b
addToFM | fm key elt | = | addToFM_C addToFM0 fm key elt |
|
|
|
| addToFM_C :: Ord b => (a -> a -> a) -> FiniteMap b a -> b -> a -> FiniteMap b a
addToFM_C | combiner EmptyFM key elt | = | unitFM key elt |
addToFM_C | combiner (Branch key elt size fm_l fm_r) new_key new_elt | |
| | new_key < key | = |
mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r |
|
| | new_key > key | = |
mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) |
|
| | otherwise | = |
Branch new_key (combiner elt new_elt) size fm_l fm_r |
|
|
|
| deleteMax :: Ord b => FiniteMap b a -> FiniteMap b a
deleteMax | (Branch key elt _ fm_l EmptyFM) | = | fm_l |
deleteMax | (Branch key elt _ fm_l fm_r) | = | mkBalBranch key elt fm_l (deleteMax fm_r) |
|
| deleteMin :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMin | (Branch key elt _ EmptyFM fm_r) | = | fm_r |
deleteMin | (Branch key elt _ fm_l fm_r) | = | mkBalBranch key elt (deleteMin fm_l) fm_r |
|
| emptyFM :: FiniteMap b a
|
| filterFM :: Ord a => (a -> b -> Bool) -> FiniteMap a b -> FiniteMap a b
filterFM | p EmptyFM | = | emptyFM |
filterFM | p (Branch key elt _ fm_l fm_r) | |
| | p key elt | = |
mkVBalBranch key elt (filterFM p fm_l) (filterFM p fm_r) |
|
| | otherwise | = |
glueVBal (filterFM p fm_l) (filterFM p fm_r) |
|
|
|
| findMax :: FiniteMap a b -> (a,b)
findMax | (Branch key elt _ _ EmptyFM) | = | (key,elt) |
findMax | (Branch key elt _ _ fm_r) | = | findMax fm_r |
|
| findMin :: FiniteMap a b -> (a,b)
findMin | (Branch key elt _ EmptyFM _) | = | (key,elt) |
findMin | (Branch key elt _ fm_l _) | = | findMin fm_l |
|
| glueBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a
glueBal | EmptyFM fm2 | = | fm2 |
glueBal | fm1 EmptyFM | = | fm1 |
glueBal | fm1 fm2 | |
| | sizeFM fm2 > sizeFM fm1 | = |
mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) |
|
| | otherwise | = |
mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 | where |
|
mid_elt10 | (_,mid_elt1) | = | mid_elt1 |
|
|
mid_elt20 | (_,mid_elt2) | = | mid_elt2 |
|
|
mid_key10 | (mid_key1,_) | = | mid_key1 |
|
|
mid_key20 | (mid_key2,_) | = | mid_key2 |
|
|
|
|
|
|
|
| glueVBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a
glueVBal | EmptyFM fm2 | = | fm2 |
glueVBal | fm1 EmptyFM | = | fm1 |
glueVBal | fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch key_r elt_r (glueVBal fm_l fm_rl) fm_rr |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch key_l elt_l fm_ll (glueVBal fm_lr fm_r) |
|
| | otherwise | = |
|
|
|
| mkBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkBalBranch | key elt fm_L fm_R | |
| | size_l + size_r < 2 | = |
mkBranch 1 key elt fm_L fm_R |
|
| | size_r > sIZE_RATIO * size_l | = |
mkBalBranch0 fm_L fm_R fm_R |
|
| | size_l > sIZE_RATIO * size_r | = |
mkBalBranch1 fm_L fm_R fm_L |
|
| | otherwise | = |
mkBranch 2 key elt fm_L fm_R | where |
double_L | fm_l (Branch key_r elt_r _ (Branch key_rl elt_rl _ fm_rll fm_rlr) fm_rr) | = | mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr) |
|
double_R | (Branch key_l elt_l _ fm_ll (Branch key_lr elt_lr _ fm_lrl fm_lrr)) fm_r | = | mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r) |
|
mkBalBranch0 | fm_L fm_R (Branch _ _ _ fm_rl fm_rr) | |
| | sizeFM fm_rl < 2 * sizeFM fm_rr | = |
|
| | otherwise | = |
|
|
|
mkBalBranch1 | fm_L fm_R (Branch _ _ _ fm_ll fm_lr) | |
| | sizeFM fm_lr < 2 * sizeFM fm_ll | = |
|
| | otherwise | = |
|
|
|
single_L | fm_l (Branch key_r elt_r _ fm_rl fm_rr) | = | mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr |
|
single_R | (Branch key_l elt_l _ fm_ll fm_lr) fm_r | = | mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r) |
|
|
|
|
|
|
|
| mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBranch | which key elt fm_l fm_r | = |
let |
result | | = | Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r |
|
|
in | result |
| where |
|
left_ok | | = | left_ok0 fm_l key fm_l |
|
left_ok0 | fm_l key EmptyFM | = | True |
left_ok0 | fm_l key (Branch left_key _ _ _ _) | = |
let |
biggest_left_key | | = | fst (findMax fm_l) |
|
|
in | biggest_left_key < key |
|
|
|
right_ok | | = | right_ok0 fm_r key fm_r |
|
right_ok0 | fm_r key EmptyFM | = | True |
right_ok0 | fm_r key (Branch right_key _ _ _ _) | = |
let |
smallest_right_key | | = | fst (findMin fm_r) |
|
|
in | key < smallest_right_key |
|
|
|
unbox :: Int -> Int
|
|
|
|
| mkVBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkVBalBranch | key elt EmptyFM fm_r | = | addToFM fm_r key elt |
mkVBalBranch | key elt fm_l EmptyFM | = | addToFM fm_l key elt |
mkVBalBranch | key elt fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch key_r elt_r (mkVBalBranch key elt fm_l fm_rl) fm_rr |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch key_l elt_l fm_ll (mkVBalBranch key elt fm_lr fm_r) |
|
| | otherwise | = |
mkBranch 13 key elt fm_l fm_r | where |
|
|
|
|
| sIZE_RATIO :: Int
|
| sizeFM :: FiniteMap a b -> Int
sizeFM | EmptyFM | = | 0 |
sizeFM | (Branch _ _ size _ _) | = | size |
|
| unitFM :: b -> a -> FiniteMap b a
unitFM | key elt | = | Branch key elt 1 emptyFM emptyFM |
|
| import qualified Maybe import qualified Prelude
|
| data FiniteMap b a = EmptyFM | Branch b a Int (FiniteMap b a) (FiniteMap b a)
|
| instance (Eq a, Eq b) => Eq (FiniteMap a b) where
|
| addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b
addToFM | fm key elt | = | addToFM_C addToFM0 fm key elt |
|
|
|
| addToFM_C :: Ord b => (a -> a -> a) -> FiniteMap b a -> b -> a -> FiniteMap b a
addToFM_C | combiner EmptyFM key elt | = | unitFM key elt |
addToFM_C | combiner (Branch key elt size fm_l fm_r) new_key new_elt | |
| | new_key < key | = |
mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r |
|
| | new_key > key | = |
mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) |
|
| | otherwise | = |
Branch new_key (combiner elt new_elt) size fm_l fm_r |
|
|
|
| deleteMax :: Ord b => FiniteMap b a -> FiniteMap b a
deleteMax | (Branch key elt vuu fm_l EmptyFM) | = | fm_l |
deleteMax | (Branch key elt vuv fm_l fm_r) | = | mkBalBranch key elt fm_l (deleteMax fm_r) |
|
| deleteMin :: Ord b => FiniteMap b a -> FiniteMap b a
deleteMin | (Branch key elt vzy EmptyFM fm_r) | = | fm_r |
deleteMin | (Branch key elt vzz fm_l fm_r) | = | mkBalBranch key elt (deleteMin fm_l) fm_r |
|
| emptyFM :: FiniteMap a b
|
| filterFM :: Ord b => (b -> a -> Bool) -> FiniteMap b a -> FiniteMap b a
filterFM | p EmptyFM | = | emptyFM |
filterFM | p (Branch key elt wuu fm_l fm_r) | |
| | p key elt | = |
mkVBalBranch key elt (filterFM p fm_l) (filterFM p fm_r) |
|
| | otherwise | = |
glueVBal (filterFM p fm_l) (filterFM p fm_r) |
|
|
|
| findMax :: FiniteMap b a -> (b,a)
findMax | (Branch key elt vzu vzv EmptyFM) | = | (key,elt) |
findMax | (Branch key elt vzw vzx fm_r) | = | findMax fm_r |
|
| findMin :: FiniteMap a b -> (a,b)
findMin | (Branch key elt wy EmptyFM wz) | = | (key,elt) |
findMin | (Branch key elt xu fm_l xv) | = | findMin fm_l |
|
| glueBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a
glueBal | EmptyFM fm2 | = | fm2 |
glueBal | fm1 EmptyFM | = | fm1 |
glueBal | fm1 fm2 | |
| | sizeFM fm2 > sizeFM fm1 | = |
mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) |
|
| | otherwise | = |
mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 | where |
|
mid_elt10 | (vyw,mid_elt1) | = | mid_elt1 |
|
|
mid_elt20 | (vyx,mid_elt2) | = | mid_elt2 |
|
|
mid_key10 | (mid_key1,vyy) | = | mid_key1 |
|
|
mid_key20 | (mid_key2,vyz) | = | mid_key2 |
|
|
|
|
|
|
|
| glueVBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a
glueVBal | EmptyFM fm2 | = | fm2 |
glueVBal | fm1 EmptyFM | = | fm1 |
glueVBal | (Branch yv yw yx yy yz) (Branch zv zw zx zy zz) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch zv zw (glueVBal (Branch yv yw yx yy yz) zy) zz |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch yv yw yy (glueVBal yz (Branch zv zw zx zy zz)) |
|
| | otherwise | = |
glueBal (Branch yv yw yx yy yz) (Branch zv zw zx zy zz) | where |
size_l | | = | sizeFM (Branch yv yw yx yy yz) |
|
size_r | | = | sizeFM (Branch zv zw zx zy zz) |
|
|
|
|
|
| mkBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkBalBranch | key elt fm_L fm_R | |
| | size_l + size_r < 2 | = |
mkBranch 1 key elt fm_L fm_R |
|
| | size_r > sIZE_RATIO * size_l | = |
mkBalBranch0 fm_L fm_R fm_R |
|
| | size_l > sIZE_RATIO * size_r | = |
mkBalBranch1 fm_L fm_R fm_L |
|
| | otherwise | = |
mkBranch 2 key elt fm_L fm_R | where |
double_L | fm_l (Branch key_r elt_r vxw (Branch key_rl elt_rl vxx fm_rll fm_rlr) fm_rr) | = | mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr) |
|
double_R | (Branch key_l elt_l vxu fm_ll (Branch key_lr elt_lr vxv fm_lrl fm_lrr)) fm_r | = | mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r) |
|
mkBalBranch0 | fm_L fm_R (Branch vxy vxz vyu fm_rl fm_rr) | |
| | sizeFM fm_rl < 2 * sizeFM fm_rr | = |
|
| | otherwise | = |
|
|
|
mkBalBranch1 | fm_L fm_R (Branch vwx vwy vwz fm_ll fm_lr) | |
| | sizeFM fm_lr < 2 * sizeFM fm_ll | = |
|
| | otherwise | = |
|
|
|
single_L | fm_l (Branch key_r elt_r vyv fm_rl fm_rr) | = | mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr |
|
single_R | (Branch key_l elt_l vww fm_ll fm_lr) fm_r | = | mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r) |
|
|
|
|
|
|
|
| mkBranch :: Ord a => Int -> a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkBranch | which key elt fm_l fm_r | = |
let |
result | | = | Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r |
|
|
in | result |
| where |
|
left_ok | | = | left_ok0 fm_l key fm_l |
|
left_ok0 | fm_l key EmptyFM | = | True |
left_ok0 | fm_l key (Branch left_key wu wv ww wx) | = |
let |
biggest_left_key | | = | fst (findMax fm_l) |
|
|
in | biggest_left_key < key |
|
|
|
right_ok | | = | right_ok0 fm_r key fm_r |
|
right_ok0 | fm_r key EmptyFM | = | True |
right_ok0 | fm_r key (Branch right_key vw vx vy vz) | = |
let |
smallest_right_key | | = | fst (findMin fm_r) |
|
|
in | key < smallest_right_key |
|
|
|
unbox :: Int -> Int
|
|
|
|
| mkVBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkVBalBranch | key elt EmptyFM fm_r | = | addToFM fm_r key elt |
mkVBalBranch | key elt fm_l EmptyFM | = | addToFM fm_l key elt |
mkVBalBranch | key elt (Branch vux vuy vuz vvu vvv) (Branch vvx vvy vvz vwu vwv) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch vvx vvy (mkVBalBranch key elt (Branch vux vuy vuz vvu vvv) vwu) vwv |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch vux vuy vvu (mkVBalBranch key elt vvv (Branch vvx vvy vvz vwu vwv)) |
|
| | otherwise | = |
mkBranch 13 key elt (Branch vux vuy vuz vvu vvv) (Branch vvx vvy vvz vwu vwv) | where |
size_l | | = | sizeFM (Branch vux vuy vuz vvu vvv) |
|
size_r | | = | sizeFM (Branch vvx vvy vvz vwu vwv) |
|
|
|
|
|
| sIZE_RATIO :: Int
|
| sizeFM :: FiniteMap a b -> Int
sizeFM | EmptyFM | = | 0 |
sizeFM | (Branch xw xx size xy xz) | = | size |
|
| unitFM :: a -> b -> FiniteMap a b
unitFM | key elt | = | Branch key elt 1 emptyFM emptyFM |
|
| import qualified Maybe import qualified Prelude
|
| data FiniteMap a b = EmptyFM | Branch a b Int (FiniteMap a b) (FiniteMap a b)
|
| instance (Eq a, Eq b) => Eq (FiniteMap b a) where
|
| addToFM :: Ord b => FiniteMap b a -> b -> a -> FiniteMap b a
addToFM | fm key elt | = | addToFM_C addToFM0 fm key elt |
|
|
|
| addToFM_C :: Ord b => (a -> a -> a) -> FiniteMap b a -> b -> a -> FiniteMap b a
addToFM_C | combiner EmptyFM key elt | = | addToFM_C4 combiner EmptyFM key elt |
addToFM_C | combiner (Branch key elt size fm_l fm_r) new_key new_elt | = | addToFM_C3 combiner (Branch key elt size fm_l fm_r) new_key new_elt |
|
|
addToFM_C0 | combiner key elt size fm_l fm_r new_key new_elt True | = | Branch new_key (combiner elt new_elt) size fm_l fm_r |
|
|
addToFM_C1 | combiner key elt size fm_l fm_r new_key new_elt True | = | mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) |
addToFM_C1 | combiner key elt size fm_l fm_r new_key new_elt False | = | addToFM_C0 combiner key elt size fm_l fm_r new_key new_elt otherwise |
|
|
addToFM_C2 | combiner key elt size fm_l fm_r new_key new_elt True | = | mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r |
addToFM_C2 | combiner key elt size fm_l fm_r new_key new_elt False | = | addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt (new_key > key) |
|
|
addToFM_C3 | combiner (Branch key elt size fm_l fm_r) new_key new_elt | = | addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt (new_key < key) |
|
|
addToFM_C4 | combiner EmptyFM key elt | = | unitFM key elt |
addToFM_C4 | wzy wzz xuu xuv | = | addToFM_C3 wzy wzz xuu xuv |
|
| deleteMax :: Ord b => FiniteMap b a -> FiniteMap b a
deleteMax | (Branch key elt vuu fm_l EmptyFM) | = | fm_l |
deleteMax | (Branch key elt vuv fm_l fm_r) | = | mkBalBranch key elt fm_l (deleteMax fm_r) |
|
| deleteMin :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMin | (Branch key elt vzy EmptyFM fm_r) | = | fm_r |
deleteMin | (Branch key elt vzz fm_l fm_r) | = | mkBalBranch key elt (deleteMin fm_l) fm_r |
|
| emptyFM :: FiniteMap a b
|
| filterFM :: Ord b => (b -> a -> Bool) -> FiniteMap b a -> FiniteMap b a
filterFM | p EmptyFM | = | filterFM3 p EmptyFM |
filterFM | p (Branch key elt wuu fm_l fm_r) | = | filterFM2 p (Branch key elt wuu fm_l fm_r) |
|
|
filterFM0 | p key elt wuu fm_l fm_r True | = | glueVBal (filterFM p fm_l) (filterFM p fm_r) |
|
|
filterFM1 | p key elt wuu fm_l fm_r True | = | mkVBalBranch key elt (filterFM p fm_l) (filterFM p fm_r) |
filterFM1 | p key elt wuu fm_l fm_r False | = | filterFM0 p key elt wuu fm_l fm_r otherwise |
|
|
filterFM2 | p (Branch key elt wuu fm_l fm_r) | = | filterFM1 p key elt wuu fm_l fm_r (p key elt) |
|
|
filterFM3 | p EmptyFM | = | emptyFM |
filterFM3 | xuy xuz | = | filterFM2 xuy xuz |
|
| findMax :: FiniteMap a b -> (a,b)
findMax | (Branch key elt vzu vzv EmptyFM) | = | (key,elt) |
findMax | (Branch key elt vzw vzx fm_r) | = | findMax fm_r |
|
| findMin :: FiniteMap b a -> (b,a)
findMin | (Branch key elt wy EmptyFM wz) | = | (key,elt) |
findMin | (Branch key elt xu fm_l xv) | = | findMin fm_l |
|
| glueBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
glueBal | EmptyFM fm2 | = | glueBal4 EmptyFM fm2 |
glueBal | fm1 EmptyFM | = | glueBal3 fm1 EmptyFM |
glueBal | fm1 fm2 | = | glueBal2 fm1 fm2 |
|
|
glueBal2 | fm1 fm2 | = |
glueBal1 fm1 fm2 (sizeFM fm2 > sizeFM fm1) | where |
glueBal0 | fm1 fm2 True | = | mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 |
|
glueBal1 | fm1 fm2 True | = | mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) |
glueBal1 | fm1 fm2 False | = | glueBal0 fm1 fm2 otherwise |
|
|
mid_elt10 | (vyw,mid_elt1) | = | mid_elt1 |
|
|
mid_elt20 | (vyx,mid_elt2) | = | mid_elt2 |
|
|
mid_key10 | (mid_key1,vyy) | = | mid_key1 |
|
|
mid_key20 | (mid_key2,vyz) | = | mid_key2 |
|
|
|
|
|
|
|
glueBal3 | fm1 EmptyFM | = | fm1 |
glueBal3 | wyx wyy | = | glueBal2 wyx wyy |
|
|
glueBal4 | EmptyFM fm2 | = | fm2 |
glueBal4 | wzu wzv | = | glueBal3 wzu wzv |
|
| glueVBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
glueVBal | EmptyFM fm2 | = | glueVBal5 EmptyFM fm2 |
glueVBal | fm1 EmptyFM | = | glueVBal4 fm1 EmptyFM |
glueVBal | (Branch yv yw yx yy yz) (Branch zv zw zx zy zz) | = | glueVBal3 (Branch yv yw yx yy yz) (Branch zv zw zx zy zz) |
|
|
glueVBal3 | (Branch yv yw yx yy yz) (Branch zv zw zx zy zz) | = |
glueVBal2 yv yw yx yy yz zv zw zx zy zz (sIZE_RATIO * size_l < size_r) | where |
glueVBal0 | yv yw yx yy yz zv zw zx zy zz True | = | glueBal (Branch yv yw yx yy yz) (Branch zv zw zx zy zz) |
|
glueVBal1 | yv yw yx yy yz zv zw zx zy zz True | = | mkBalBranch yv yw yy (glueVBal yz (Branch zv zw zx zy zz)) |
glueVBal1 | yv yw yx yy yz zv zw zx zy zz False | = | glueVBal0 yv yw yx yy yz zv zw zx zy zz otherwise |
|
glueVBal2 | yv yw yx yy yz zv zw zx zy zz True | = | mkBalBranch zv zw (glueVBal (Branch yv yw yx yy yz) zy) zz |
glueVBal2 | yv yw yx yy yz zv zw zx zy zz False | = | glueVBal1 yv yw yx yy yz zv zw zx zy zz (sIZE_RATIO * size_r < size_l) |
|
size_l | | = | sizeFM (Branch yv yw yx yy yz) |
|
size_r | | = | sizeFM (Branch zv zw zx zy zz) |
|
|
|
|
|
glueVBal4 | fm1 EmptyFM | = | fm1 |
glueVBal4 | wvv wvw | = | glueVBal3 wvv wvw |
|
|
glueVBal5 | EmptyFM fm2 | = | fm2 |
glueVBal5 | wvy wvz | = | glueVBal4 wvy wvz |
|
| mkBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkBalBranch | key elt fm_L fm_R | = | mkBalBranch6 key elt fm_L fm_R |
|
|
mkBalBranch6 | key elt fm_L fm_R | = |
mkBalBranch5 key elt fm_L fm_R (size_l + size_r < 2) | where |
double_L | fm_l (Branch key_r elt_r vxw (Branch key_rl elt_rl vxx fm_rll fm_rlr) fm_rr) | = | mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr) |
|
double_R | (Branch key_l elt_l vxu fm_ll (Branch key_lr elt_lr vxv fm_lrl fm_lrr)) fm_r | = | mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r) |
|
mkBalBranch0 | fm_L fm_R (Branch vxy vxz vyu fm_rl fm_rr) | = | mkBalBranch02 fm_L fm_R (Branch vxy vxz vyu fm_rl fm_rr) |
|
mkBalBranch00 | fm_L fm_R vxy vxz vyu fm_rl fm_rr True | = | double_L fm_L fm_R |
|
mkBalBranch01 | fm_L fm_R vxy vxz vyu fm_rl fm_rr True | = | single_L fm_L fm_R |
mkBalBranch01 | fm_L fm_R vxy vxz vyu fm_rl fm_rr False | = | mkBalBranch00 fm_L fm_R vxy vxz vyu fm_rl fm_rr otherwise |
|
mkBalBranch02 | fm_L fm_R (Branch vxy vxz vyu fm_rl fm_rr) | = | mkBalBranch01 fm_L fm_R vxy vxz vyu fm_rl fm_rr (sizeFM fm_rl < 2 * sizeFM fm_rr) |
|
mkBalBranch1 | fm_L fm_R (Branch vwx vwy vwz fm_ll fm_lr) | = | mkBalBranch12 fm_L fm_R (Branch vwx vwy vwz fm_ll fm_lr) |
|
mkBalBranch10 | fm_L fm_R vwx vwy vwz fm_ll fm_lr True | = | double_R fm_L fm_R |
|
mkBalBranch11 | fm_L fm_R vwx vwy vwz fm_ll fm_lr True | = | single_R fm_L fm_R |
mkBalBranch11 | fm_L fm_R vwx vwy vwz fm_ll fm_lr False | = | mkBalBranch10 fm_L fm_R vwx vwy vwz fm_ll fm_lr otherwise |
|
mkBalBranch12 | fm_L fm_R (Branch vwx vwy vwz fm_ll fm_lr) | = | mkBalBranch11 fm_L fm_R vwx vwy vwz fm_ll fm_lr (sizeFM fm_lr < 2 * sizeFM fm_ll) |
|
mkBalBranch2 | key elt fm_L fm_R True | = | mkBranch 2 key elt fm_L fm_R |
|
mkBalBranch3 | key elt fm_L fm_R True | = | mkBalBranch1 fm_L fm_R fm_L |
mkBalBranch3 | key elt fm_L fm_R False | = | mkBalBranch2 key elt fm_L fm_R otherwise |
|
mkBalBranch4 | key elt fm_L fm_R True | = | mkBalBranch0 fm_L fm_R fm_R |
mkBalBranch4 | key elt fm_L fm_R False | = | mkBalBranch3 key elt fm_L fm_R (size_l > sIZE_RATIO * size_r) |
|
mkBalBranch5 | key elt fm_L fm_R True | = | mkBranch 1 key elt fm_L fm_R |
mkBalBranch5 | key elt fm_L fm_R False | = | mkBalBranch4 key elt fm_L fm_R (size_r > sIZE_RATIO * size_l) |
|
single_L | fm_l (Branch key_r elt_r vyv fm_rl fm_rr) | = | mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr |
|
single_R | (Branch key_l elt_l vww fm_ll fm_lr) fm_r | = | mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r) |
|
|
|
|
|
|
| mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBranch | which key elt fm_l fm_r | = |
let |
result | | = | Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r |
|
|
in | result |
| where |
|
left_ok | | = | left_ok0 fm_l key fm_l |
|
left_ok0 | fm_l key EmptyFM | = | True |
left_ok0 | fm_l key (Branch left_key wu wv ww wx) | = |
let |
biggest_left_key | | = | fst (findMax fm_l) |
|
|
in | biggest_left_key < key |
|
|
|
right_ok | | = | right_ok0 fm_r key fm_r |
|
right_ok0 | fm_r key EmptyFM | = | True |
right_ok0 | fm_r key (Branch right_key vw vx vy vz) | = |
let |
smallest_right_key | | = | fst (findMin fm_r) |
|
|
in | key < smallest_right_key |
|
|
|
unbox :: Int -> Int
|
|
|
|
| mkVBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkVBalBranch | key elt EmptyFM fm_r | = | mkVBalBranch5 key elt EmptyFM fm_r |
mkVBalBranch | key elt fm_l EmptyFM | = | mkVBalBranch4 key elt fm_l EmptyFM |
mkVBalBranch | key elt (Branch vux vuy vuz vvu vvv) (Branch vvx vvy vvz vwu vwv) | = | mkVBalBranch3 key elt (Branch vux vuy vuz vvu vvv) (Branch vvx vvy vvz vwu vwv) |
|
|
mkVBalBranch3 | key elt (Branch vux vuy vuz vvu vvv) (Branch vvx vvy vvz vwu vwv) | = |
mkVBalBranch2 key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv (sIZE_RATIO * size_l < size_r) | where |
mkVBalBranch0 | key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv True | = | mkBranch 13 key elt (Branch vux vuy vuz vvu vvv) (Branch vvx vvy vvz vwu vwv) |
|
mkVBalBranch1 | key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv True | = | mkBalBranch vux vuy vvu (mkVBalBranch key elt vvv (Branch vvx vvy vvz vwu vwv)) |
mkVBalBranch1 | key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv False | = | mkVBalBranch0 key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv otherwise |
|
mkVBalBranch2 | key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv True | = | mkBalBranch vvx vvy (mkVBalBranch key elt (Branch vux vuy vuz vvu vvv) vwu) vwv |
mkVBalBranch2 | key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv False | = | mkVBalBranch1 key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv (sIZE_RATIO * size_r < size_l) |
|
size_l | | = | sizeFM (Branch vux vuy vuz vvu vvv) |
|
size_r | | = | sizeFM (Branch vvx vvy vvz vwu vwv) |
|
|
|
|
|
mkVBalBranch4 | key elt fm_l EmptyFM | = | addToFM fm_l key elt |
mkVBalBranch4 | wwx wwy wwz wxu | = | mkVBalBranch3 wwx wwy wwz wxu |
|
|
mkVBalBranch5 | key elt EmptyFM fm_r | = | addToFM fm_r key elt |
mkVBalBranch5 | wxw wxx wxy wxz | = | mkVBalBranch4 wxw wxx wxy wxz |
|
| sIZE_RATIO :: Int
|
| sizeFM :: FiniteMap b a -> Int
sizeFM | EmptyFM | = | 0 |
sizeFM | (Branch xw xx size xy xz) | = | size |
|
| unitFM :: b -> a -> FiniteMap b a
unitFM | key elt | = | Branch key elt 1 emptyFM emptyFM |
|
| import qualified Maybe import qualified Prelude
|
| data FiniteMap a b = EmptyFM | Branch a b Int (FiniteMap a b) (FiniteMap a b)
|
| instance (Eq a, Eq b) => Eq (FiniteMap b a) where
|
| addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b
addToFM | fm key elt | = | addToFM_C addToFM0 fm key elt |
|
|
|
| addToFM_C :: Ord a => (b -> b -> b) -> FiniteMap a b -> a -> b -> FiniteMap a b
addToFM_C | combiner EmptyFM key elt | = | addToFM_C4 combiner EmptyFM key elt |
addToFM_C | combiner (Branch key elt size fm_l fm_r) new_key new_elt | = | addToFM_C3 combiner (Branch key elt size fm_l fm_r) new_key new_elt |
|
|
addToFM_C0 | combiner key elt size fm_l fm_r new_key new_elt True | = | Branch new_key (combiner elt new_elt) size fm_l fm_r |
|
|
addToFM_C1 | combiner key elt size fm_l fm_r new_key new_elt True | = | mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) |
addToFM_C1 | combiner key elt size fm_l fm_r new_key new_elt False | = | addToFM_C0 combiner key elt size fm_l fm_r new_key new_elt otherwise |
|
|
addToFM_C2 | combiner key elt size fm_l fm_r new_key new_elt True | = | mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r |
addToFM_C2 | combiner key elt size fm_l fm_r new_key new_elt False | = | addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt (new_key > key) |
|
|
addToFM_C3 | combiner (Branch key elt size fm_l fm_r) new_key new_elt | = | addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt (new_key < key) |
|
|
addToFM_C4 | combiner EmptyFM key elt | = | unitFM key elt |
addToFM_C4 | wzy wzz xuu xuv | = | addToFM_C3 wzy wzz xuu xuv |
|
| deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMax | (Branch key elt vuu fm_l EmptyFM) | = | fm_l |
deleteMax | (Branch key elt vuv fm_l fm_r) | = | mkBalBranch key elt fm_l (deleteMax fm_r) |
|
| deleteMin :: Ord b => FiniteMap b a -> FiniteMap b a
deleteMin | (Branch key elt vzy EmptyFM fm_r) | = | fm_r |
deleteMin | (Branch key elt vzz fm_l fm_r) | = | mkBalBranch key elt (deleteMin fm_l) fm_r |
|
| emptyFM :: FiniteMap a b
|
| filterFM :: Ord b => (b -> a -> Bool) -> FiniteMap b a -> FiniteMap b a
filterFM | p EmptyFM | = | filterFM3 p EmptyFM |
filterFM | p (Branch key elt wuu fm_l fm_r) | = | filterFM2 p (Branch key elt wuu fm_l fm_r) |
|
|
filterFM0 | p key elt wuu fm_l fm_r True | = | glueVBal (filterFM p fm_l) (filterFM p fm_r) |
|
|
filterFM1 | p key elt wuu fm_l fm_r True | = | mkVBalBranch key elt (filterFM p fm_l) (filterFM p fm_r) |
filterFM1 | p key elt wuu fm_l fm_r False | = | filterFM0 p key elt wuu fm_l fm_r otherwise |
|
|
filterFM2 | p (Branch key elt wuu fm_l fm_r) | = | filterFM1 p key elt wuu fm_l fm_r (p key elt) |
|
|
filterFM3 | p EmptyFM | = | emptyFM |
filterFM3 | xuy xuz | = | filterFM2 xuy xuz |
|
| findMax :: FiniteMap b a -> (b,a)
findMax | (Branch key elt vzu vzv EmptyFM) | = | (key,elt) |
findMax | (Branch key elt vzw vzx fm_r) | = | findMax fm_r |
|
| findMin :: FiniteMap a b -> (a,b)
findMin | (Branch key elt wy EmptyFM wz) | = | (key,elt) |
findMin | (Branch key elt xu fm_l xv) | = | findMin fm_l |
|
| glueBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
glueBal | EmptyFM fm2 | = | glueBal4 EmptyFM fm2 |
glueBal | fm1 EmptyFM | = | glueBal3 fm1 EmptyFM |
glueBal | fm1 fm2 | = | glueBal2 fm1 fm2 |
|
|
glueBal2 | fm1 fm2 | = | glueBal2GlueBal1 fm1 fm2 fm1 fm2 (sizeFM fm2 > sizeFM fm1) |
|
|
glueBal2GlueBal0 | yuv yuw fm1 fm2 True | = | mkBalBranch (glueBal2Mid_key1 yuv yuw) (glueBal2Mid_elt1 yuv yuw) (deleteMax fm1) fm2 |
|
|
glueBal2GlueBal1 | yuv yuw fm1 fm2 True | = | mkBalBranch (glueBal2Mid_key2 yuv yuw) (glueBal2Mid_elt2 yuv yuw) fm1 (deleteMin fm2) |
glueBal2GlueBal1 | yuv yuw fm1 fm2 False | = | glueBal2GlueBal0 yuv yuw fm1 fm2 otherwise |
|
|
glueBal2Mid_elt1 | yuv yuw | = | glueBal2Mid_elt10 yuv yuw (glueBal2Vv2 yuv yuw) |
|
|
glueBal2Mid_elt10 | yuv yuw (vyw,mid_elt1) | = | mid_elt1 |
|
|
glueBal2Mid_elt2 | yuv yuw | = | glueBal2Mid_elt20 yuv yuw (glueBal2Vv3 yuv yuw) |
|
|
glueBal2Mid_elt20 | yuv yuw (vyx,mid_elt2) | = | mid_elt2 |
|
|
glueBal2Mid_key1 | yuv yuw | = | glueBal2Mid_key10 yuv yuw (glueBal2Vv2 yuv yuw) |
|
|
glueBal2Mid_key10 | yuv yuw (mid_key1,vyy) | = | mid_key1 |
|
|
glueBal2Mid_key2 | yuv yuw | = | glueBal2Mid_key20 yuv yuw (glueBal2Vv3 yuv yuw) |
|
|
glueBal2Mid_key20 | yuv yuw (mid_key2,vyz) | = | mid_key2 |
|
|
glueBal2Vv2 | yuv yuw | = | findMax yuv |
|
|
glueBal2Vv3 | yuv yuw | = | findMin yuw |
|
|
glueBal3 | fm1 EmptyFM | = | fm1 |
glueBal3 | wyx wyy | = | glueBal2 wyx wyy |
|
|
glueBal4 | EmptyFM fm2 | = | fm2 |
glueBal4 | wzu wzv | = | glueBal3 wzu wzv |
|
| glueVBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a
glueVBal | EmptyFM fm2 | = | glueVBal5 EmptyFM fm2 |
glueVBal | fm1 EmptyFM | = | glueVBal4 fm1 EmptyFM |
glueVBal | (Branch yv yw yx yy yz) (Branch zv zw zx zy zz) | = | glueVBal3 (Branch yv yw yx yy yz) (Branch zv zw zx zy zz) |
|
|
glueVBal3 | (Branch yv yw yx yy yz) (Branch zv zw zx zy zz) | = | glueVBal3GlueVBal2 yv yw yx yy yz zv zw zx zy zz yv yw yx yy yz zv zw zx zy zz (sIZE_RATIO * glueVBal3Size_l yv yw yx yy yz zv zw zx zy zz < glueVBal3Size_r yv yw yx yy yz zv zw zx zy zz) |
|
|
glueVBal3GlueVBal0 | xvy xvz xwu xwv xww xwx xwy xwz xxu xxv yv yw yx yy yz zv zw zx zy zz True | = | glueBal (Branch yv yw yx yy yz) (Branch zv zw zx zy zz) |
|
|
glueVBal3GlueVBal1 | xvy xvz xwu xwv xww xwx xwy xwz xxu xxv yv yw yx yy yz zv zw zx zy zz True | = | mkBalBranch yv yw yy (glueVBal yz (Branch zv zw zx zy zz)) |
glueVBal3GlueVBal1 | xvy xvz xwu xwv xww xwx xwy xwz xxu xxv yv yw yx yy yz zv zw zx zy zz False | = | glueVBal3GlueVBal0 xvy xvz xwu xwv xww xwx xwy xwz xxu xxv yv yw yx yy yz zv zw zx zy zz otherwise |
|
|
glueVBal3GlueVBal2 | xvy xvz xwu xwv xww xwx xwy xwz xxu xxv yv yw yx yy yz zv zw zx zy zz True | = | mkBalBranch zv zw (glueVBal (Branch yv yw yx yy yz) zy) zz |
glueVBal3GlueVBal2 | xvy xvz xwu xwv xww xwx xwy xwz xxu xxv yv yw yx yy yz zv zw zx zy zz False | = | glueVBal3GlueVBal1 xvy xvz xwu xwv xww xwx xwy xwz xxu xxv yv yw yx yy yz zv zw zx zy zz (sIZE_RATIO * glueVBal3Size_r xvy xvz xwu xwv xww xwx xwy xwz xxu xxv < glueVBal3Size_l xvy xvz xwu xwv xww xwx xwy xwz xxu xxv) |
|
|
glueVBal3Size_l | xvy xvz xwu xwv xww xwx xwy xwz xxu xxv | = | sizeFM (Branch xvy xvz xwu xwv xww) |
|
|
glueVBal3Size_r | xvy xvz xwu xwv xww xwx xwy xwz xxu xxv | = | sizeFM (Branch xwx xwy xwz xxu xxv) |
|
|
glueVBal4 | fm1 EmptyFM | = | fm1 |
glueVBal4 | wvv wvw | = | glueVBal3 wvv wvw |
|
|
glueVBal5 | EmptyFM fm2 | = | fm2 |
glueVBal5 | wvy wvz | = | glueVBal4 wvy wvz |
|
| mkBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkBalBranch | key elt fm_L fm_R | = | mkBalBranch6 key elt fm_L fm_R |
|
|
mkBalBranch6 | key elt fm_L fm_R | = | mkBalBranch6MkBalBranch5 key elt fm_R fm_L key elt fm_L fm_R (mkBalBranch6Size_l key elt fm_R fm_L + mkBalBranch6Size_r key elt fm_R fm_L < 2) |
|
|
mkBalBranch6Double_L | xvu xvv xvw xvx fm_l (Branch key_r elt_r vxw (Branch key_rl elt_rl vxx fm_rll fm_rlr) fm_rr) | = | mkBranch 5 key_rl elt_rl (mkBranch 6 xvu xvv fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr) |
|
|
mkBalBranch6Double_R | xvu xvv xvw xvx (Branch key_l elt_l vxu fm_ll (Branch key_lr elt_lr vxv fm_lrl fm_lrr)) fm_r | = | mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 xvu xvv fm_lrr fm_r) |
|
|
mkBalBranch6MkBalBranch0 | xvu xvv xvw xvx fm_L fm_R (Branch vxy vxz vyu fm_rl fm_rr) | = | mkBalBranch6MkBalBranch02 xvu xvv xvw xvx fm_L fm_R (Branch vxy vxz vyu fm_rl fm_rr) |
|
|
mkBalBranch6MkBalBranch00 | xvu xvv xvw xvx fm_L fm_R vxy vxz vyu fm_rl fm_rr True | = | mkBalBranch6Double_L xvu xvv xvw xvx fm_L fm_R |
|
|
mkBalBranch6MkBalBranch01 | xvu xvv xvw xvx fm_L fm_R vxy vxz vyu fm_rl fm_rr True | = | mkBalBranch6Single_L xvu xvv xvw xvx fm_L fm_R |
mkBalBranch6MkBalBranch01 | xvu xvv xvw xvx fm_L fm_R vxy vxz vyu fm_rl fm_rr False | = | mkBalBranch6MkBalBranch00 xvu xvv xvw xvx fm_L fm_R vxy vxz vyu fm_rl fm_rr otherwise |
|
|
mkBalBranch6MkBalBranch02 | xvu xvv xvw xvx fm_L fm_R (Branch vxy vxz vyu fm_rl fm_rr) | = | mkBalBranch6MkBalBranch01 xvu xvv xvw xvx fm_L fm_R vxy vxz vyu fm_rl fm_rr (sizeFM fm_rl < 2 * sizeFM fm_rr) |
|
|
mkBalBranch6MkBalBranch1 | xvu xvv xvw xvx fm_L fm_R (Branch vwx vwy vwz fm_ll fm_lr) | = | mkBalBranch6MkBalBranch12 xvu xvv xvw xvx fm_L fm_R (Branch vwx vwy vwz fm_ll fm_lr) |
|
|
mkBalBranch6MkBalBranch10 | xvu xvv xvw xvx fm_L fm_R vwx vwy vwz fm_ll fm_lr True | = | mkBalBranch6Double_R xvu xvv xvw xvx fm_L fm_R |
|
|
mkBalBranch6MkBalBranch11 | xvu xvv xvw xvx fm_L fm_R vwx vwy vwz fm_ll fm_lr True | = | mkBalBranch6Single_R xvu xvv xvw xvx fm_L fm_R |
mkBalBranch6MkBalBranch11 | xvu xvv xvw xvx fm_L fm_R vwx vwy vwz fm_ll fm_lr False | = | mkBalBranch6MkBalBranch10 xvu xvv xvw xvx fm_L fm_R vwx vwy vwz fm_ll fm_lr otherwise |
|
|
mkBalBranch6MkBalBranch12 | xvu xvv xvw xvx fm_L fm_R (Branch vwx vwy vwz fm_ll fm_lr) | = | mkBalBranch6MkBalBranch11 xvu xvv xvw xvx fm_L fm_R vwx vwy vwz fm_ll fm_lr (sizeFM fm_lr < 2 * sizeFM fm_ll) |
|
|
mkBalBranch6MkBalBranch2 | xvu xvv xvw xvx key elt fm_L fm_R True | = | mkBranch 2 key elt fm_L fm_R |
|
|
mkBalBranch6MkBalBranch3 | xvu xvv xvw xvx key elt fm_L fm_R True | = | mkBalBranch6MkBalBranch1 xvu xvv xvw xvx fm_L fm_R fm_L |
mkBalBranch6MkBalBranch3 | xvu xvv xvw xvx key elt fm_L fm_R False | = | mkBalBranch6MkBalBranch2 xvu xvv xvw xvx key elt fm_L fm_R otherwise |
|
|
mkBalBranch6MkBalBranch4 | xvu xvv xvw xvx key elt fm_L fm_R True | = | mkBalBranch6MkBalBranch0 xvu xvv xvw xvx fm_L fm_R fm_R |
mkBalBranch6MkBalBranch4 | xvu xvv xvw xvx key elt fm_L fm_R False | = | mkBalBranch6MkBalBranch3 xvu xvv xvw xvx key elt fm_L fm_R (mkBalBranch6Size_l xvu xvv xvw xvx > sIZE_RATIO * mkBalBranch6Size_r xvu xvv xvw xvx) |
|
|
mkBalBranch6MkBalBranch5 | xvu xvv xvw xvx key elt fm_L fm_R True | = | mkBranch 1 key elt fm_L fm_R |
mkBalBranch6MkBalBranch5 | xvu xvv xvw xvx key elt fm_L fm_R False | = | mkBalBranch6MkBalBranch4 xvu xvv xvw xvx key elt fm_L fm_R (mkBalBranch6Size_r xvu xvv xvw xvx > sIZE_RATIO * mkBalBranch6Size_l xvu xvv xvw xvx) |
|
|
mkBalBranch6Single_L | xvu xvv xvw xvx fm_l (Branch key_r elt_r vyv fm_rl fm_rr) | = | mkBranch 3 key_r elt_r (mkBranch 4 xvu xvv fm_l fm_rl) fm_rr |
|
|
mkBalBranch6Single_R | xvu xvv xvw xvx (Branch key_l elt_l vww fm_ll fm_lr) fm_r | = | mkBranch 8 key_l elt_l fm_ll (mkBranch 9 xvu xvv fm_lr fm_r) |
|
|
mkBalBranch6Size_l | xvu xvv xvw xvx | = | sizeFM xvx |
|
|
mkBalBranch6Size_r | xvu xvv xvw xvx | = | sizeFM xvw |
|
| mkBranch :: Ord a => Int -> a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkBranch | which key elt fm_l fm_r | = | mkBranchResult key elt fm_r fm_l |
|
|
mkBranchBalance_ok | xxw xxx xxy | = | True |
|
|
mkBranchLeft_ok | xxw xxx xxy | = | mkBranchLeft_ok0 xxw xxx xxy xxy xxx xxy |
|
|
mkBranchLeft_ok0 | xxw xxx xxy fm_l key EmptyFM | = | True |
mkBranchLeft_ok0 | xxw xxx xxy fm_l key (Branch left_key wu wv ww wx) | = | mkBranchLeft_ok0Biggest_left_key fm_l < key |
|
|
mkBranchLeft_ok0Biggest_left_key | yux | = | fst (findMax yux) |
|
|
mkBranchLeft_size | xxw xxx xxy | = | sizeFM xxy |
|
|
mkBranchResult | xxz xyu xyv xyw | = | Branch xxz xyu (mkBranchUnbox xyv xxz xyw (1 + mkBranchLeft_size xyv xxz xyw + mkBranchRight_size xyv xxz xyw)) xyw xyv |
|
|
mkBranchRight_ok | xxw xxx xxy | = | mkBranchRight_ok0 xxw xxx xxy xxw xxx xxw |
|
|
mkBranchRight_ok0 | xxw xxx xxy fm_r key EmptyFM | = | True |
mkBranchRight_ok0 | xxw xxx xxy fm_r key (Branch right_key vw vx vy vz) | = | key < mkBranchRight_ok0Smallest_right_key fm_r |
|
|
mkBranchRight_ok0Smallest_right_key | yuy | = | fst (findMin yuy) |
|
|
mkBranchRight_size | xxw xxx xxy | = | sizeFM xxw |
|
| mkBranchUnbox :: Ord a => -> (FiniteMap a b) ( -> a ( -> (FiniteMap a b) (Int -> Int)))
mkBranchUnbox | xxw xxx xxy x | = | x |
|
| mkVBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkVBalBranch | key elt EmptyFM fm_r | = | mkVBalBranch5 key elt EmptyFM fm_r |
mkVBalBranch | key elt fm_l EmptyFM | = | mkVBalBranch4 key elt fm_l EmptyFM |
mkVBalBranch | key elt (Branch vux vuy vuz vvu vvv) (Branch vvx vvy vvz vwu vwv) | = | mkVBalBranch3 key elt (Branch vux vuy vuz vvu vvv) (Branch vvx vvy vvz vwu vwv) |
|
|
mkVBalBranch3 | key elt (Branch vux vuy vuz vvu vvv) (Branch vvx vvy vvz vwu vwv) | = | mkVBalBranch3MkVBalBranch2 vvx vvy vvz vwu vwv vux vuy vuz vvu vvv key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv (sIZE_RATIO * mkVBalBranch3Size_l vvx vvy vvz vwu vwv vux vuy vuz vvu vvv < mkVBalBranch3Size_r vvx vvy vvz vwu vwv vux vuy vuz vvu vvv) |
|
|
mkVBalBranch3MkVBalBranch0 | xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv True | = | mkBranch 13 key elt (Branch vux vuy vuz vvu vvv) (Branch vvx vvy vvz vwu vwv) |
|
|
mkVBalBranch3MkVBalBranch1 | xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv True | = | mkBalBranch vux vuy vvu (mkVBalBranch key elt vvv (Branch vvx vvy vvz vwu vwv)) |
mkVBalBranch3MkVBalBranch1 | xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv False | = | mkVBalBranch3MkVBalBranch0 xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv otherwise |
|
|
mkVBalBranch3MkVBalBranch2 | xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv True | = | mkBalBranch vvx vvy (mkVBalBranch key elt (Branch vux vuy vuz vvu vvv) vwu) vwv |
mkVBalBranch3MkVBalBranch2 | xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv False | = | mkVBalBranch3MkVBalBranch1 xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv (sIZE_RATIO * mkVBalBranch3Size_r xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu < mkVBalBranch3Size_l xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu) |
|
|
mkVBalBranch3Size_l | xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu | = | sizeFM (Branch xzw xzx xzy xzz yuu) |
|
|
mkVBalBranch3Size_r | xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu | = | sizeFM (Branch xyx xyy xyz xzu xzv) |
|
|
mkVBalBranch4 | key elt fm_l EmptyFM | = | addToFM fm_l key elt |
mkVBalBranch4 | wwx wwy wwz wxu | = | mkVBalBranch3 wwx wwy wwz wxu |
|
|
mkVBalBranch5 | key elt EmptyFM fm_r | = | addToFM fm_r key elt |
mkVBalBranch5 | wxw wxx wxy wxz | = | mkVBalBranch4 wxw wxx wxy wxz |
|
| sIZE_RATIO :: Int
|
| sizeFM :: FiniteMap a b -> Int
sizeFM | EmptyFM | = | 0 |
sizeFM | (Branch xw xx size xy xz) | = | size |
|
| unitFM :: b -> a -> FiniteMap b a
unitFM | key elt | = | Branch key elt 1 emptyFM emptyFM |
|
| import qualified Maybe import qualified Prelude
|
| data FiniteMap a b = EmptyFM | Branch a b Int (FiniteMap a b) (FiniteMap a b)
|
| instance (Eq a, Eq b) => Eq (FiniteMap a b) where
|
| addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b
addToFM | fm key elt | = | addToFM_C addToFM0 fm key elt |
|
|
|
| addToFM_C :: Ord a => (b -> b -> b) -> FiniteMap a b -> a -> b -> FiniteMap a b
addToFM_C | combiner EmptyFM key elt | = | addToFM_C4 combiner EmptyFM key elt |
addToFM_C | combiner (Branch key elt size fm_l fm_r) new_key new_elt | = | addToFM_C3 combiner (Branch key elt size fm_l fm_r) new_key new_elt |
|
|
addToFM_C0 | combiner key elt size fm_l fm_r new_key new_elt True | = | Branch new_key (combiner elt new_elt) size fm_l fm_r |
|
|
addToFM_C1 | combiner key elt size fm_l fm_r new_key new_elt True | = | mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) |
addToFM_C1 | combiner key elt size fm_l fm_r new_key new_elt False | = | addToFM_C0 combiner key elt size fm_l fm_r new_key new_elt otherwise |
|
|
addToFM_C2 | combiner key elt size fm_l fm_r new_key new_elt True | = | mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r |
addToFM_C2 | combiner key elt size fm_l fm_r new_key new_elt False | = | addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt (new_key > key) |
|
|
addToFM_C3 | combiner (Branch key elt size fm_l fm_r) new_key new_elt | = | addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt (new_key < key) |
|
|
addToFM_C4 | combiner EmptyFM key elt | = | unitFM key elt |
addToFM_C4 | wzy wzz xuu xuv | = | addToFM_C3 wzy wzz xuu xuv |
|
| deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMax | (Branch key elt vuu fm_l EmptyFM) | = | fm_l |
deleteMax | (Branch key elt vuv fm_l fm_r) | = | mkBalBranch key elt fm_l (deleteMax fm_r) |
|
| deleteMin :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMin | (Branch key elt vzy EmptyFM fm_r) | = | fm_r |
deleteMin | (Branch key elt vzz fm_l fm_r) | = | mkBalBranch key elt (deleteMin fm_l) fm_r |
|
| emptyFM :: FiniteMap a b
|
| filterFM :: Ord a => (a -> b -> Bool) -> FiniteMap a b -> FiniteMap a b
filterFM | p EmptyFM | = | filterFM3 p EmptyFM |
filterFM | p (Branch key elt wuu fm_l fm_r) | = | filterFM2 p (Branch key elt wuu fm_l fm_r) |
|
|
filterFM0 | p key elt wuu fm_l fm_r True | = | glueVBal (filterFM p fm_l) (filterFM p fm_r) |
|
|
filterFM1 | p key elt wuu fm_l fm_r True | = | mkVBalBranch key elt (filterFM p fm_l) (filterFM p fm_r) |
filterFM1 | p key elt wuu fm_l fm_r False | = | filterFM0 p key elt wuu fm_l fm_r otherwise |
|
|
filterFM2 | p (Branch key elt wuu fm_l fm_r) | = | filterFM1 p key elt wuu fm_l fm_r (p key elt) |
|
|
filterFM3 | p EmptyFM | = | emptyFM |
filterFM3 | xuy xuz | = | filterFM2 xuy xuz |
|
| findMax :: FiniteMap a b -> (a,b)
findMax | (Branch key elt vzu vzv EmptyFM) | = | (key,elt) |
findMax | (Branch key elt vzw vzx fm_r) | = | findMax fm_r |
|
| findMin :: FiniteMap b a -> (b,a)
findMin | (Branch key elt wy EmptyFM wz) | = | (key,elt) |
findMin | (Branch key elt xu fm_l xv) | = | findMin fm_l |
|
| glueBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a
glueBal | EmptyFM fm2 | = | glueBal4 EmptyFM fm2 |
glueBal | fm1 EmptyFM | = | glueBal3 fm1 EmptyFM |
glueBal | fm1 fm2 | = | glueBal2 fm1 fm2 |
|
|
glueBal2 | fm1 fm2 | = | glueBal2GlueBal1 fm1 fm2 fm1 fm2 (sizeFM fm2 > sizeFM fm1) |
|
|
glueBal2GlueBal0 | yuv yuw fm1 fm2 True | = | mkBalBranch (glueBal2Mid_key1 yuv yuw) (glueBal2Mid_elt1 yuv yuw) (deleteMax fm1) fm2 |
|
|
glueBal2GlueBal1 | yuv yuw fm1 fm2 True | = | mkBalBranch (glueBal2Mid_key2 yuv yuw) (glueBal2Mid_elt2 yuv yuw) fm1 (deleteMin fm2) |
glueBal2GlueBal1 | yuv yuw fm1 fm2 False | = | glueBal2GlueBal0 yuv yuw fm1 fm2 otherwise |
|
|
glueBal2Mid_elt1 | yuv yuw | = | glueBal2Mid_elt10 yuv yuw (glueBal2Vv2 yuv yuw) |
|
|
glueBal2Mid_elt10 | yuv yuw (vyw,mid_elt1) | = | mid_elt1 |
|
|
glueBal2Mid_elt2 | yuv yuw | = | glueBal2Mid_elt20 yuv yuw (glueBal2Vv3 yuv yuw) |
|
|
glueBal2Mid_elt20 | yuv yuw (vyx,mid_elt2) | = | mid_elt2 |
|
|
glueBal2Mid_key1 | yuv yuw | = | glueBal2Mid_key10 yuv yuw (glueBal2Vv2 yuv yuw) |
|
|
glueBal2Mid_key10 | yuv yuw (mid_key1,vyy) | = | mid_key1 |
|
|
glueBal2Mid_key2 | yuv yuw | = | glueBal2Mid_key20 yuv yuw (glueBal2Vv3 yuv yuw) |
|
|
glueBal2Mid_key20 | yuv yuw (mid_key2,vyz) | = | mid_key2 |
|
|
glueBal2Vv2 | yuv yuw | = | findMax yuv |
|
|
glueBal2Vv3 | yuv yuw | = | findMin yuw |
|
|
glueBal3 | fm1 EmptyFM | = | fm1 |
glueBal3 | wyx wyy | = | glueBal2 wyx wyy |
|
|
glueBal4 | EmptyFM fm2 | = | fm2 |
glueBal4 | wzu wzv | = | glueBal3 wzu wzv |
|
| glueVBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
glueVBal | EmptyFM fm2 | = | glueVBal5 EmptyFM fm2 |
glueVBal | fm1 EmptyFM | = | glueVBal4 fm1 EmptyFM |
glueVBal | (Branch yv yw yx yy yz) (Branch zv zw zx zy zz) | = | glueVBal3 (Branch yv yw yx yy yz) (Branch zv zw zx zy zz) |
|
|
glueVBal3 | (Branch yv yw yx yy yz) (Branch zv zw zx zy zz) | = | glueVBal3GlueVBal2 yv yw yx yy yz zv zw zx zy zz yv yw yx yy yz zv zw zx zy zz (sIZE_RATIO * glueVBal3Size_l yv yw yx yy yz zv zw zx zy zz < glueVBal3Size_r yv yw yx yy yz zv zw zx zy zz) |
|
|
glueVBal3GlueVBal0 | xvy xvz xwu xwv xww xwx xwy xwz xxu xxv yv yw yx yy yz zv zw zx zy zz True | = | glueBal (Branch yv yw yx yy yz) (Branch zv zw zx zy zz) |
|
|
glueVBal3GlueVBal1 | xvy xvz xwu xwv xww xwx xwy xwz xxu xxv yv yw yx yy yz zv zw zx zy zz True | = | mkBalBranch yv yw yy (glueVBal yz (Branch zv zw zx zy zz)) |
glueVBal3GlueVBal1 | xvy xvz xwu xwv xww xwx xwy xwz xxu xxv yv yw yx yy yz zv zw zx zy zz False | = | glueVBal3GlueVBal0 xvy xvz xwu xwv xww xwx xwy xwz xxu xxv yv yw yx yy yz zv zw zx zy zz otherwise |
|
|
glueVBal3GlueVBal2 | xvy xvz xwu xwv xww xwx xwy xwz xxu xxv yv yw yx yy yz zv zw zx zy zz True | = | mkBalBranch zv zw (glueVBal (Branch yv yw yx yy yz) zy) zz |
glueVBal3GlueVBal2 | xvy xvz xwu xwv xww xwx xwy xwz xxu xxv yv yw yx yy yz zv zw zx zy zz False | = | glueVBal3GlueVBal1 xvy xvz xwu xwv xww xwx xwy xwz xxu xxv yv yw yx yy yz zv zw zx zy zz (sIZE_RATIO * glueVBal3Size_r xvy xvz xwu xwv xww xwx xwy xwz xxu xxv < glueVBal3Size_l xvy xvz xwu xwv xww xwx xwy xwz xxu xxv) |
|
|
glueVBal3Size_l | xvy xvz xwu xwv xww xwx xwy xwz xxu xxv | = | sizeFM (Branch xvy xvz xwu xwv xww) |
|
|
glueVBal3Size_r | xvy xvz xwu xwv xww xwx xwy xwz xxu xxv | = | sizeFM (Branch xwx xwy xwz xxu xxv) |
|
|
glueVBal4 | fm1 EmptyFM | = | fm1 |
glueVBal4 | wvv wvw | = | glueVBal3 wvv wvw |
|
|
glueVBal5 | EmptyFM fm2 | = | fm2 |
glueVBal5 | wvy wvz | = | glueVBal4 wvy wvz |
|
| mkBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBalBranch | key elt fm_L fm_R | = | mkBalBranch6 key elt fm_L fm_R |
|
|
mkBalBranch6 | key elt fm_L fm_R | = | mkBalBranch6MkBalBranch5 key elt fm_R fm_L key elt fm_L fm_R (mkBalBranch6Size_l key elt fm_R fm_L + mkBalBranch6Size_r key elt fm_R fm_L < Pos (Succ (Succ Zero))) |
|
|
mkBalBranch6Double_L | xvu xvv xvw xvx fm_l (Branch key_r elt_r vxw (Branch key_rl elt_rl vxx fm_rll fm_rlr) fm_rr) | = | mkBranch (Pos (Succ (Succ (Succ (Succ (Succ Zero)))))) key_rl elt_rl (mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ Zero))))))) xvu xvv fm_l fm_rll) (mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))) key_r elt_r fm_rlr fm_rr) |
|
|
mkBalBranch6Double_R | xvu xvv xvw xvx (Branch key_l elt_l vxu fm_ll (Branch key_lr elt_lr vxv fm_lrl fm_lrr)) fm_r | = | mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero))))))))))) key_lr elt_lr (mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))))))) key_l elt_l fm_ll fm_lrl) (mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero))))))))))))) xvu xvv fm_lrr fm_r) |
|
|
mkBalBranch6MkBalBranch0 | xvu xvv xvw xvx fm_L fm_R (Branch vxy vxz vyu fm_rl fm_rr) | = | mkBalBranch6MkBalBranch02 xvu xvv xvw xvx fm_L fm_R (Branch vxy vxz vyu fm_rl fm_rr) |
|
|
mkBalBranch6MkBalBranch00 | xvu xvv xvw xvx fm_L fm_R vxy vxz vyu fm_rl fm_rr True | = | mkBalBranch6Double_L xvu xvv xvw xvx fm_L fm_R |
|
|
mkBalBranch6MkBalBranch01 | xvu xvv xvw xvx fm_L fm_R vxy vxz vyu fm_rl fm_rr True | = | mkBalBranch6Single_L xvu xvv xvw xvx fm_L fm_R |
mkBalBranch6MkBalBranch01 | xvu xvv xvw xvx fm_L fm_R vxy vxz vyu fm_rl fm_rr False | = | mkBalBranch6MkBalBranch00 xvu xvv xvw xvx fm_L fm_R vxy vxz vyu fm_rl fm_rr otherwise |
|
|
mkBalBranch6MkBalBranch02 | xvu xvv xvw xvx fm_L fm_R (Branch vxy vxz vyu fm_rl fm_rr) | = | mkBalBranch6MkBalBranch01 xvu xvv xvw xvx fm_L fm_R vxy vxz vyu fm_rl fm_rr (sizeFM fm_rl < Pos (Succ (Succ Zero)) * sizeFM fm_rr) |
|
|
mkBalBranch6MkBalBranch1 | xvu xvv xvw xvx fm_L fm_R (Branch vwx vwy vwz fm_ll fm_lr) | = | mkBalBranch6MkBalBranch12 xvu xvv xvw xvx fm_L fm_R (Branch vwx vwy vwz fm_ll fm_lr) |
|
|
mkBalBranch6MkBalBranch10 | xvu xvv xvw xvx fm_L fm_R vwx vwy vwz fm_ll fm_lr True | = | mkBalBranch6Double_R xvu xvv xvw xvx fm_L fm_R |
|
|
mkBalBranch6MkBalBranch11 | xvu xvv xvw xvx fm_L fm_R vwx vwy vwz fm_ll fm_lr True | = | mkBalBranch6Single_R xvu xvv xvw xvx fm_L fm_R |
mkBalBranch6MkBalBranch11 | xvu xvv xvw xvx fm_L fm_R vwx vwy vwz fm_ll fm_lr False | = | mkBalBranch6MkBalBranch10 xvu xvv xvw xvx fm_L fm_R vwx vwy vwz fm_ll fm_lr otherwise |
|
|
mkBalBranch6MkBalBranch12 | xvu xvv xvw xvx fm_L fm_R (Branch vwx vwy vwz fm_ll fm_lr) | = | mkBalBranch6MkBalBranch11 xvu xvv xvw xvx fm_L fm_R vwx vwy vwz fm_ll fm_lr (sizeFM fm_lr < Pos (Succ (Succ Zero)) * sizeFM fm_ll) |
|
|
mkBalBranch6MkBalBranch2 | xvu xvv xvw xvx key elt fm_L fm_R True | = | mkBranch (Pos (Succ (Succ Zero))) key elt fm_L fm_R |
|
|
mkBalBranch6MkBalBranch3 | xvu xvv xvw xvx key elt fm_L fm_R True | = | mkBalBranch6MkBalBranch1 xvu xvv xvw xvx fm_L fm_R fm_L |
mkBalBranch6MkBalBranch3 | xvu xvv xvw xvx key elt fm_L fm_R False | = | mkBalBranch6MkBalBranch2 xvu xvv xvw xvx key elt fm_L fm_R otherwise |
|
|
mkBalBranch6MkBalBranch4 | xvu xvv xvw xvx key elt fm_L fm_R True | = | mkBalBranch6MkBalBranch0 xvu xvv xvw xvx fm_L fm_R fm_R |
mkBalBranch6MkBalBranch4 | xvu xvv xvw xvx key elt fm_L fm_R False | = | mkBalBranch6MkBalBranch3 xvu xvv xvw xvx key elt fm_L fm_R (mkBalBranch6Size_l xvu xvv xvw xvx > sIZE_RATIO * mkBalBranch6Size_r xvu xvv xvw xvx) |
|
|
mkBalBranch6MkBalBranch5 | xvu xvv xvw xvx key elt fm_L fm_R True | = | mkBranch (Pos (Succ Zero)) key elt fm_L fm_R |
mkBalBranch6MkBalBranch5 | xvu xvv xvw xvx key elt fm_L fm_R False | = | mkBalBranch6MkBalBranch4 xvu xvv xvw xvx key elt fm_L fm_R (mkBalBranch6Size_r xvu xvv xvw xvx > sIZE_RATIO * mkBalBranch6Size_l xvu xvv xvw xvx) |
|
|
mkBalBranch6Single_L | xvu xvv xvw xvx fm_l (Branch key_r elt_r vyv fm_rl fm_rr) | = | mkBranch (Pos (Succ (Succ (Succ Zero)))) key_r elt_r (mkBranch (Pos (Succ (Succ (Succ (Succ Zero))))) xvu xvv fm_l fm_rl) fm_rr |
|
|
mkBalBranch6Single_R | xvu xvv xvw xvx (Branch key_l elt_l vww fm_ll fm_lr) fm_r | = | mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero))))))))) key_l elt_l fm_ll (mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))))) xvu xvv fm_lr fm_r) |
|
|
mkBalBranch6Size_l | xvu xvv xvw xvx | = | sizeFM xvx |
|
|
mkBalBranch6Size_r | xvu xvv xvw xvx | = | sizeFM xvw |
|
| mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBranch | which key elt fm_l fm_r | = | mkBranchResult key elt fm_r fm_l |
|
|
mkBranchBalance_ok | xxw xxx xxy | = | True |
|
|
mkBranchLeft_ok | xxw xxx xxy | = | mkBranchLeft_ok0 xxw xxx xxy xxy xxx xxy |
|
|
mkBranchLeft_ok0 | xxw xxx xxy fm_l key EmptyFM | = | True |
mkBranchLeft_ok0 | xxw xxx xxy fm_l key (Branch left_key wu wv ww wx) | = | mkBranchLeft_ok0Biggest_left_key fm_l < key |
|
|
mkBranchLeft_ok0Biggest_left_key | yux | = | fst (findMax yux) |
|
|
mkBranchLeft_size | xxw xxx xxy | = | sizeFM xxy |
|
|
mkBranchResult | xxz xyu xyv xyw | = | Branch xxz xyu (mkBranchUnbox xyv xxz xyw (Pos (Succ Zero) + mkBranchLeft_size xyv xxz xyw + mkBranchRight_size xyv xxz xyw)) xyw xyv |
|
|
mkBranchRight_ok | xxw xxx xxy | = | mkBranchRight_ok0 xxw xxx xxy xxw xxx xxw |
|
|
mkBranchRight_ok0 | xxw xxx xxy fm_r key EmptyFM | = | True |
mkBranchRight_ok0 | xxw xxx xxy fm_r key (Branch right_key vw vx vy vz) | = | key < mkBranchRight_ok0Smallest_right_key fm_r |
|
|
mkBranchRight_ok0Smallest_right_key | yuy | = | fst (findMin yuy) |
|
|
mkBranchRight_size | xxw xxx xxy | = | sizeFM xxw |
|
| mkBranchUnbox :: Ord a => -> (FiniteMap a b) ( -> a ( -> (FiniteMap a b) (Int -> Int)))
mkBranchUnbox | xxw xxx xxy x | = | x |
|
| mkVBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkVBalBranch | key elt EmptyFM fm_r | = | mkVBalBranch5 key elt EmptyFM fm_r |
mkVBalBranch | key elt fm_l EmptyFM | = | mkVBalBranch4 key elt fm_l EmptyFM |
mkVBalBranch | key elt (Branch vux vuy vuz vvu vvv) (Branch vvx vvy vvz vwu vwv) | = | mkVBalBranch3 key elt (Branch vux vuy vuz vvu vvv) (Branch vvx vvy vvz vwu vwv) |
|
|
mkVBalBranch3 | key elt (Branch vux vuy vuz vvu vvv) (Branch vvx vvy vvz vwu vwv) | = | mkVBalBranch3MkVBalBranch2 vvx vvy vvz vwu vwv vux vuy vuz vvu vvv key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv (sIZE_RATIO * mkVBalBranch3Size_l vvx vvy vvz vwu vwv vux vuy vuz vvu vvv < mkVBalBranch3Size_r vvx vvy vvz vwu vwv vux vuy vuz vvu vvv) |
|
|
mkVBalBranch3MkVBalBranch0 | xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv True | = | mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))))))))) key elt (Branch vux vuy vuz vvu vvv) (Branch vvx vvy vvz vwu vwv) |
|
|
mkVBalBranch3MkVBalBranch1 | xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv True | = | mkBalBranch vux vuy vvu (mkVBalBranch key elt vvv (Branch vvx vvy vvz vwu vwv)) |
mkVBalBranch3MkVBalBranch1 | xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv False | = | mkVBalBranch3MkVBalBranch0 xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv otherwise |
|
|
mkVBalBranch3MkVBalBranch2 | xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv True | = | mkBalBranch vvx vvy (mkVBalBranch key elt (Branch vux vuy vuz vvu vvv) vwu) vwv |
mkVBalBranch3MkVBalBranch2 | xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv False | = | mkVBalBranch3MkVBalBranch1 xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu key elt vux vuy vuz vvu vvv vvx vvy vvz vwu vwv (sIZE_RATIO * mkVBalBranch3Size_r xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu < mkVBalBranch3Size_l xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu) |
|
|
mkVBalBranch3Size_l | xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu | = | sizeFM (Branch xzw xzx xzy xzz yuu) |
|
|
mkVBalBranch3Size_r | xyx xyy xyz xzu xzv xzw xzx xzy xzz yuu | = | sizeFM (Branch xyx xyy xyz xzu xzv) |
|
|
mkVBalBranch4 | key elt fm_l EmptyFM | = | addToFM fm_l key elt |
mkVBalBranch4 | wwx wwy wwz wxu | = | mkVBalBranch3 wwx wwy wwz wxu |
|
|
mkVBalBranch5 | key elt EmptyFM fm_r | = | addToFM fm_r key elt |
mkVBalBranch5 | wxw wxx wxy wxz | = | mkVBalBranch4 wxw wxx wxy wxz |
|
| sIZE_RATIO :: Int
sIZE_RATIO | | = | Pos (Succ (Succ (Succ (Succ (Succ Zero))))) |
|
| sizeFM :: FiniteMap b a -> Int
sizeFM | EmptyFM | = | Pos Zero |
sizeFM | (Branch xw xx size xy xz) | = | size |
|
| unitFM :: b -> a -> FiniteMap b a
unitFM | key elt | = | Branch key elt (Pos (Succ Zero)) emptyFM emptyFM |
|